perm filename PLOT.SAI[11,ALS]2 blob
sn#068795 filedate 1973-10-29 generic text, type T, neo UTF8
00010 BEGIN "PLOT"
00020 DEFINE ⊂="COMMENT"; ⊂ AUG.2,1973;
00030 DEFINE ⊃="⊂";
00040 DEFINE CR="'15",LF="'12",CRLF="CR&LF",TB="'11";
00050 REQUIRE "DPYSUB.HDR[1,PDQ]" SOURCE_FILE;
00060 LABEL STARTP,STOPP,TOFORM;
00070 DEFINE \=" "; ⊂ DEFINE \="SAFE"; ⊂ Alternarte definitions;
00080 REQUIRE "LPC2[X,ALS]" LOAD_MODULE;
00090 FORTRAN REAL PROCEDURE SQRT(REAL X);
00100 FORTRAN REAL PROCEDURE ALOG10(REAL X);
00110 FORTRAN REAL PROCEDURE COS(REAL X);
00120 FORTRAN REAL PROCEDURE SIN(REAL X);
00130 INTEGER ZEROC,ZEROF,DX;
00140 EXTERNAL FORTRAN PROCEDURE LPC1
00155 (REFERENCE REAL A,B,R0,C;REFERENCE INTEGER N,I,J);
00170 REQUIRE "F[X,ALS]" LOAD_MODULE;
00180 EXTERNAL FORTRAN PROCEDURE FRXFM
00190 (REFERENCE INTEGER M;REFERENCE REAL X,Y);
00200 \ INTERNAL REAL ARRAY A,B,C,D[0:512];
00210 REAL X,SX; \ REAL ARRAY WINDOW[0:512];
00220 INTERNAL REAL R0;
00230 INTEGER LPCOPT;
00240 \ INTEGER ARRAY DPYBUF[0:4095];
00250 \ INTEGER ARRAY LFILE[0:'177];
00260 \ INTEGER ARRAY SYMBOL[0:127];
00270 \ INTEGER ARRAY DAT,AVDAT[0:23];
00280 STRING ARRAY SAMPLE[0:127];
00290 INTEGER I,J,K,L,P,PP,Q,QQ,R,DK,DDK,DDDK,DVAL,DDVAL,DDDVAL,
00300 POINTX,STATE,DELTA,VAL,CHAN1,EOF,POINTT,POINTV;
00305 INTERNAL INTEGER M,N;
00310 INTEGER PT0,PT1,PT2,X0,X1,Y0,Y1,X2,Y2,
00320 PTCNT,PICK,JP,JPX,OPT,OPT1,SHUFCT;
00330 INTEGER II,JJ,KK,NN,SEGC,BRK,EOFA,READ3,
00340 SEGTOT,SEGIN,IIT,JJT,KKT,NNT,SEGCT;
00350 BOOLEAN ER;
00360 INTEGER CHAN2,CHAN3,CHAN4,CHAN5,CHAN6,CHANX;
00370 \ INTEGER ARRAY BUF,BUFT[0:511];
00380 STRING FILEN,READ,READ1,READT,FILEO,READ2,FILEQ,TFILE,FILLST;
00390
00400 PROCEDURE OUTALL(STRING S);
00410 BEGIN
00420 STRING SS; INTEGER J;
00430 SETBREAK(18,0,NULL,"OSN");
00440 SS←SCAN(S,18,J);
00450 OUTSTR(SS);
00460 END;
00470
00480 PROCEDURE DATAIN;
00490 BEGIN
00500 INTEGER J;
00510 FOR J←0 STEP 1 UNTIL 511 DO BUF[J]←0;
00520 IF EOF=0 THEN ARRYIN(CHAN1,BUF[0],512)
00530 ELSE OUTSTR
00540 ("No more data with JJ= "&CVS(JJ)&"SEGC= "&CVS(SEGC)&CRLF);
00550 POINTX←POINT(12,BUF[0],-1);
00560 SEGC←II←II+12; JJ←II+11;
00570 END;
00580
00590 PROCEDURE DATTIN;
00600 BEGIN
00610 INTEGER J;
00620 FOR J←0 STEP 1 UNTIL 511 DO BUFT[J]←0;
00630 IF EOFA=0 THEN ARRYIN(CHAN2,BUFT[0],512)
00640 ELSE OUTSTR
00650 ("No more T0X data with JJ= "&CVS(JJ)&"SEGC= "&CVS(SEGC)&CRLF);
00660 POINTT←POINT(6,BUFT[0],-1);
00670 SEGCT←IIT←IIT+128; JJT←IIT+127;
00680 END;
00690
00700
00710 PROCEDURE PLOT;
00720 BEGIN
00730 INTEGER I,JP,K,LP;
00740 PTCNT←PTCNT+1; IF PTCNT≤4 THEN BEGIN
00750 POINTV←POINTX;
00760 K←LDB(POINTV); IF K>2047 THEN K←K-4096;
00770 K←K%8;
00780
00790 RIVECT(0,K);
00800 FOR I←0 STEP 1 UNTIL 127 DO BEGIN
00810 JP←ILDB(POINTV); IF JP>2047 THEN JP←JP-4096;
00820 D[DX]←JP; DX←DX+1;
00830 ⊃ SETFORMAT(10,3); ⊃ OUTSTR(CVS(I)&TB&CVG(JP)&CRLF);
00840 JP←JP%8;
00850 LP←JP-K; RVECT(1,LP); K←JP; END;
00860 RIVECT(0,-K);
00870 IF PTCNT=4 THEN BEGIN
00880 RIVECT(-200,-130);
00890 READ←CVSTR(SYMBOL[Q])[1 TO 1];
00900 IF OPT1=1 THEN BEGIN
00910 DPYSST(CVXSTR(LFILE[10])[2 TO 3]&" "&READ&" ? "&CVS(JPX));
00920 SETFORMAT(1,0);
00930 IF (J-JPX)<0 THEN DPYSST(CVS(J-JPX)) ELSE DPYSST("+"&CVS(J-JPX));
00940 SETFORMAT(3,0); END;
00950 IF OPT1≠1 THEN
00960 DPYSST(CVXSTR(LFILE[10])[2 TO 3]&" "&READ&" "&CVS(J)&" "&CVS(KK));
00970 RIVECT(60,130); END;
00980 END;END;
00990
01000 PROCEDURE FRIC;
01010 BEGIN
01020 INTEGER JJJ;
01030 ⊂ STATE=0 means on way up
01040 STATE=1 means on way down;
01050 M←0;
01060 PLOT;
01075 FOR JJJ←0 STEP 1 UNTIL 127 DO BEGIN
01080 VAL←ILDB(POINTX); IF VAL>2047 THEN VAL←VAL-4096;
01085 DVAL←VAL-K; DDVAL←DVAL-DK; DDDVAL←DDVAL-DDK;
01090 IF STATE=0 THEN BEGIN
01095 IF DDDVAL<DDDK-DELTA THEN BEGIN
01100 M←M+(DDDK-DDDVAL); STATE←-1; END; END ELSE
01105 IF DDDVAL>DDDK+DELTA THEN BEGIN
01110 M←M+(DDDVAL-DDDK); STATE←0; END;
01115 K←VAL; DK←DVAL;DDK←DDVAL; DDDK←DDDVAL;
01117 IF JJJ=2 THEN M←0;
01120 END;
01125 M←M%400; IF M>63 THEN M←63;
01180 SEGC←SEGC+1;
01190 END;
01200
01210 PROCEDURE DATA;
01220 BEGIN
01230 INTEGER I;
01240 FOR I←0 STEP 1 UNTIL 23 DO BEGIN
01250 DAT[I]←ILDB(POINTT);
01260 AVDAT[I]←AVDAT[I]+DAT[I];
01270 END;
01280 SEGCT←SEGCT+1;
01290 END;
01300
01310 PROCEDURE TYDATT;
01320 BEGIN
01330 INTEGER I,J,K;
01340 K←0;
01350 FOR I←0 STEP 1 UNTIL 23 DO BEGIN
01360 J←ILDB(POINTT);
01370 OUTALL(CVS(J));
01380 END; OUTSTR(CRLF); END;
01390
01400 PROCEDURE SKIP;
01410 BEGIN
01420 INTEGER JJJ;
01430 FOR JJJ←0 STEP 1 UNTIL 127 DO IBP(POINTX);
01440 K←LDB(POINTX); IF K>2047 THEN K←K-4096;
01450 SEGC←SEGC+1;
01460 ⊃ OUTSTR("Skip to segc= "&CVS(SEGC)&CRLF);
01470 END;
01480
01490 PROCEDURE SKIPT;
01500 BEGIN
01510 INTEGER JJJ;
01520 FOR JJJ←0 STEP 1 UNTIL 23 DO IBP(POINTT);
01530 SEGCT←SEGCT+1;
01540 ⊃ OUTSTR("Skip to segct= "&CVS(SEGCT)&CRLF);
01550 END;
01560
01570 PROCEDURE SHUFFLE;
01580 BEGIN "SHUF"
01590 INTEGER I,J,K;
01600
01610 AIVECT(-640,-365);
01620 I←DPYPTR-PT1; ⊂ Words to save;
01630 J←PT1-PT0; ⊂ Words to overwrite;
01640 FOR K←1 STEP 1 UNTIL I DO DPYBUF[K+3]←DPYBUF[K+3+J];
01650 FOR K←I+1 STEP 1 UNTIL J+I DO DPYBUF[K+3]←1;
01660 PT1←DPYPTR←PT0+I;
01670 DPYOUT(0); PTOCHW(0,'10120);
01680 END "SHUF";
01690
01700 PROCEDURE RARDIS;
01710 BEGIN
01720 INTEGER I,J,K,SP;
01730 INTEGER LY,DY;
01740 REAL MAX,MIN;
01750
01760 MAX←-1000.;MIN←10000.;
01770 FOR I←0 STEP 1 UNTIL N%2 DO IF C[I]>MAX THEN MAX←C[I];
01780 SP←2; COMMENT HORIZONTAL SPACING;
01790 FOR I←0 STEP 1 UNTIL N%2-1 DO BEGIN
01800 C[I]←5.5*(C[I]+48-MAX); IF C[I]<0 THEN C[I]←0; END;
01810 RIVECT(0,80);
01811
01812 DPYSST("6"); RIVECT(-15,-20); DPYSST("D"); RIVECT(-15,-20);
01813 DPYSST("B"); RIVECT(-15,-40); DPYSST("s"); RIVECT(-15,-20);
01814 DPYSST("t"); RIVECT(-15,-20); DPYSST("e"); RIVECT(-15,-20);
01815 DPYSST("p"); RIVECT(-15,-20); DPYSST("s"); RIVECT(120,-64);
01816 DPYSST("2.5"); RIVECT(104,0); DPYSST("5"); RIVECT(94,0);
01817 DPYSST("7.5"); RIVECT(94,0); DPYSST("10"); RIVECT(-535,296);
01818
01820 FOR I←0 STEP 1 UNTIL 3 DO BEGIN
01830 RVECT(-10,0); RVECT(10,0); RVECT(0,-33);
01840 RVECT(-5,0); RIVECT(5,0); RVECT(0,-33); END;
01850 FOR I←0 STEP 1 UNTIL 7 DO BEGIN
01860 RVECT(32,0); RVECT(0,-5); RIVECT(0,5);
01870 RVECT(32,0); RVECT(0,-10); RIVECT(0,10); END; RIVECT(-512,0);
01880 LY←C[0]; RIVECT(0,LY);
01890 FOR I←0 STEP 1 UNTIL N%2 DO
01900 BEGIN
01910 DY←C[I]-LY;
01920 LY←LY+DY;
01930 RVECT(SP,DY);
01940 END;
01950 RIVECT(0,128-LY);
01960 END "RARDIS";
01970
01980 INTERNAL PROCEDURE XRTRAN(REAL ARRAY A,B;INTEGER N,EVALUATE);
01990 BEGIN
02000 COMMENT IF EVALUATE IS FALSE THIS INTERNAL PROCEDURE UNSCRAMBLES THE SINGLE VARIATE
02010 COMPLEX TRANSFORM ;
02020 INTEGER K,NK,NH;
02030 REAL AA,AB,BA,BB,RE,IM,CK,SK,DC,DS,R;
02040 NH←N%2; R←3.1415926536/N;
02050 DS←SIN(R); R←-(2*SIN(0.5*R))↑2;
02060 DC←-0.5*R; CK←1.0; SK←0;
02070 IF EVALUATE THEN
02080 BEGIN
02090 CK←-1.0; DC←-DC;
02100 END
02110 ELSE
02120 BEGIN
02130 A[N]←A[0]; B[N]←B[0];
02140 END;
02150 FOR K←0 STEP 1 UNTIL NH DO
02160 BEGIN
02170 NK←N-K;
02180 AA←A[K]+A[NK]; AB←A[K]-A[NK];
02190 BA←B[K]+B[NK]; BB←B[K]-B[NK];
02200 RE←CK*BA+SK*AB; IM←SK*BA-CK*AB;
02210 B[NK]←IM-BB; B[K]←IM+BB;
02220 A[NK]←AA-RE; A[K]←AA+RE;
02230 DC←R*CK+DC; CK←CK+DC;
02240 DS←R*SK+DS; SK←SK+DS;
02250 END;
02260 END "XRTRAN";
02270
02280 INTERNAL PROCEDURE FORM(INTEGER LPCOPT);
02290 BEGIN "FORM"
02300 REAL ERRN,ERR;
02310 INTEGER I,J;
02320 M←9; N←2↑M; DEFINE PI="3.141592653";
02330 IF WINDOW[N%2]=0 THEN
02340 FOR I←0 STEP 1 UNTIL N DO WINDOW[I]←(1-COS((2*PI*I)/N))/2;
02350 FOR I←0 STEP 1 UNTIL N DO A[I]←D[I];
02360 IF LPCOPT=0 THEN BEGIN "LPC"
02370 FOR I←0 STEP 1 UNTIL N-2 DO A[I]←(A[I+1]-A[I])*WINDOW[I];
02380 ⊂ LOADS DATA IN A, DIFFERENTIATES AND WINDOWS ;
02390 I←24; J←N%2; LPC1(A[0],B[0],R0,C[0],N,I,J);
02400 END "LPC" ELSE BEGIN "FFT"
02410 FOR I←0 STEP 1 UNTIL N DO BEGIN
02420 A[I]←D[I]*WINDOW[I]; B[I]←0;
02430 ⊃ SETFORMAT(10,3); ⊃ OUTSTR(CVS(I)&TB&CVG(D[I])&TB&CVG(A[I])&CRLF);
02440 END; I←24; J←N%2;
02450 FRXFM(M,A[0],B[0]);
02460 ⊃ OUTSTR("FFT COMPLETE"&CRLF);
02470 FOR I←0 STEP 1 UNTIL N%2 DO BEGIN
02480 X←A[I]↑2+B[I]↑2+1.*10↑-37;
02490 ⊃ OUTSTR(CVG(A[I])&" "&CVG(B[I])&" "&CVG(X)&TB);
02500 C[I]←10.*ALOG10(X); END;
02510 END "FFT";
02520 RARDIS;
02530 END "FORM";
00010 TYPLOC(512,80);
00020 DPYSET(DPYBUF); AIVECT(-640,-90); PT0←DPYPTR;
00030 SHUFCT←0;AIVECT(-640,-365);PT1←DPYPTR;
00040 FILEN←"HI20.001[CMP,JH]";
00050 FILEO←"SEG1.FRI";
00060 ⊂ HEADIN;
00070 STDBRK(1);
00080 SETBREAK(14,"∃",NULL,"INS");
00090 SETBREAK(15,'11&'12&'14&'15&'40,NULL,"INS");
00100 SETBREAK(16,'56,NULL,"INA");
00110 SETBREAK(17,'12,'15,"INS");
00120
00130 CHAN1←1; CHAN2←2; CHAN3←3; CHAN4←4; CHAN5←5; CHAN6←6;
00140 OUTSTR("This program will show header information and wave forms for"
00150 &CRLF&" a selected phonette. After every display it waits for a "
00160 &crlf&" single letter command or a number(followed by a CR)."&CRLF&
00170 " A space bar causes it to continue, a letter S causes it "
00180 &CRLF&"start over by asking for a phonette, while an E exits."&CRLF);
00190 OUTSTR("A positive or negative number causes it to shift by the specified "&
00200 CRLF&"amount and then give data for the next 4 segments."&CRLF);
00205 OUTSTR("After a + shift has been effected giving a line feed will get one to "&
00207 crlf&"the next specified PH from this point while a space bar will go to "&
00208 CRLF&"the next specified PH even if this means backing up."&CRLF);
00210 OUTSTR("At present this program takes acoustic data from [CMP,JH],"&
00220 CRLF&" indentifying information from MAP.PHM[11,ALS]"&
00230 CRLF&" and header information from files .T0X[11,ALS]."&CRLF&LF);
00240
00250 CLOSE(CHAN4); OPEN(CHAN4,"DSK",1,2,0,3500,BRK,EOFA);
00260 LOOKUP(CHAN4,"MAP.PHN[11,ALS]",ER);
00270 WHILE ER DO BEGIN OUTSTR(CRLF&"Can't find MAP.PHN[11,ALS]. File = ");
00280 LOOKUP(CHAN4,TFILE←INCHWL,ER); END; EOFA←0;
00290 FILLST←INPUT(CHAN4,14);
00310 CLOSE(CHAN4);
00320
00330 FOR I←0 STEP 1 UNTIL 127 DO BEGIN
00340 WHILE TRUE DO BEGIN
00350 READ1←SCAN(FILLST,17,K);
00360 READ3←READ1[1 TO 1];
00370 IF READ3≠"⊂" THEN DONE; END;
00380 IF READ3="" THEN DONE;
00390 SYMBOL[I]←CVASC(SCAN(READ1,15,K));
00400 SAMPLE[I]←READ1; END;
00410
00420 STARTP:
00430 WHILE TRUE DO BEGIN "PICK"
00440 OUTSTR("Type PH with CR to select (CR only for everything) ");
00450 IF (READ←INCHWL)="" THEN DONE ELSE BEGIN PICK←CVASC(READ);
00470 FOR Q←0 STEP 1 UNTIL 127 DO IF PICK=SYMBOL[Q] THEN DONE;
00480 IF Q<128 THEN DONE;
00490 OUTSTR("Not found"&crlf); END; END "PICK";
00500
00510 OUTSTR(CRLF&"You have selected "&tb);
00520 IF READ="" THEN BEGIN OPT←0; OUTSTR("Everything"&crlf); END ELSE BEGIN
00530 OUTALL(CVSTR(PICK)&TB&SAMPLE[Q]&CRLF&" "); OPT←1; END;
00540 DELTA←15;
00550 ⊂ OUTSTR("Specify DELTA (CR for 15) ");
00560 ⊂ IF (READ←INCHWL)="" THEN DELTA←15 ELSE DELTA←CVD(READ);
00570
00580 FOR PP←1 STEP 1 UNTIL 26 DO BEGIN "FILEREAD"
00590 CLOSE(CHAN1); OPEN(CHAN1,"DSK",'10,10,0,0,0,EOF);
00600 SETFORMAT(-3,0); FILEQ←CVS(PP);
00610 FILEN←FILEN[1 TO 5]&FILEQ&"[CMP,JH]";
00620 LOOKUP(CHAN1,FILEN,ER); TFILE←FILEN;
00630 WHILE ER DO BEGIN
00640 IF PP>1 THEN BEGIN OUTSTR("Out of data, will start over."&CRLF);
00650 GOTO STARTP; END;
00660 OUTSTR(CRLF&"Can not find file "&TFILE&" File= ");
00670 LOOKUP(CHAN1,TFILE←INCHWL,ER); END;
00680 J←K←L←STATE←VAL←R←0;
00690 SETFORMAT(1,0); FILEQ←CVS(PP);
00700
00710 READT←FILEO[1 TO 3]&FILEQ&".T0X[11,ALS]";
00720 CLOSE(CHAN2); OPEN(CHAN2,"DSK",'10,10,0,0,0,EOFA);
00730 LOOKUP(CHAN2,READT,ER); TFILE←READT;
00740 WHILE ER DO BEGIN
00750 IF PP>1 THEN BEGIN OUTSTR("Out of data, will start over."&CRLF);
00760 GOTO STARTP; END;
00770 OUTSTR(CRLF&"Can not find file "&TFILE&" File= ");
00780 LOOKUP(CHAN2,TFILE←INCHWL,ER); END;
00790 ARRYIN(CHAN2,LFILE[0],'200); ⊂ Input header;
00800 SEGTOT←(LFILE[0]*6)%256;
00810 ⊃ OUTSTR(FILEI&" "&CVS(SEGTOT)&" ");
00820
00830 READ2←READT;
00840 READ1←SCAN(READ2,16,J)&"DOC";
00850 ⊃ OUTSTR("Ready to write "&READ1&TB);
00910
00920 II←-11; JJ←-1; IIT←-127; JJT←-1; SETFORMAT(3,0); SEGIN←0;
00930
00940 ⊂ Begin "SELECT";
00950
00960 FOR I←21 STEP 1 UNTIL 127 DO BEGIN "SELECT"
00970 IF LFILE[I]=0 THEN IF I>0 THEN DONE ELSE BEGIN
00980 OUTSTR("No data."&crlf); done end;
00990 L←LFILE[I] LAND '777760000000;
01000
01010 ⊂ Begin "FOUND";
01020
01030 IF (OPT=0) ∨ (L=PICK) THEN BEGIN "FOUND"
01040 FOR Q←0 STEP 1 UNTIL 126 DO IF L=SYMBOL[Q] THEN DONE;
01050 JPX←J←LDB(POINT(14,LFILE[I],27)); KK←LDB(POINT(8,LFILE[I],35));
01060
01070 ⊂ Begin "GET";
01080
01090 WHILE TRUE DO BEGIN "GET"
01100
01110 IF KK<4 THEN PTCNT←4-KK ELSE PTCNT←0;
01120
01130 IF II>J THEN BEGIN
01135 IF (READ1='12) THEN CONTINUE "SELECT";
01140 CLOSE(CHAN1); OPEN(CHAN1,"DSK",'10,10,0,0,0,EOF);
01150 LOOKUP(CHAN1,FILEN,ER); TFILE←FILEN;
01160 WHILE ER DO BEGIN
01170 OUTSTR(CRLF&"Can not find file "&TFILE&" File= ");
01180 LOOKUP(CHAN1,TFILE←INCHWL,ER); END;
01190 II←-11; JJ←-1;
01200 END;
01210
01220 IF IIT>J THEN BEGIN
01225 IF (READ1='12) THEN CONTINUE "SELECT";
01230 CLOSE(CHAN2); OPEN(CHAN2,"DSK",'10,10,0,0,0,EOFA);
01240 LOOKUP(CHAN2,READT,ER); TFILE←READT;
01250 WHILE ER DO BEGIN
01260 OUTSTR(CRLF&"Can not find file "&TFILE&" File= ");
01270 LOOKUP(CHAN2,TFILE←INCHWL,ER); END;
01280 ARRYIN(CHAN2,LFILE[0],'200); ⊂ Input header;
01290 IIT←-127; JJT←-1;
01300 END;
01310
01320 WHILE JJ<J DO DATAIN; WHILE JJT<J DO DATTIN;
01330
01340 IF SEGC>J THEN BEGIN
01350 POINTX←POINT(12,BUF[0],-1);
01360 SEGC←II; JJ←II+11; END;
01370
01380 IF SEGCT>J THEN BEGIN
01390 POINTT←POINT(6,BUFT[0],-1);
01400 SEGCT←IIT; JJT←IIT+127; END;
01410
01420 WHILE SEGC<J DO SKIP; WHILE SEGCT<J DO SKIPT;
01430
01440 IF SHUFCT=0 THEN BEGIN
01450 OUTSTR(
01460 " F1 F3 A2 FP1 FP2 FZ NP NZ LPE HPE HPA PIT"
01470 &CRLF&
01480 " F2 A1 A3 FP1A FP2A FZA NPA NZA AVE LPA FRI FRI4"
01490 &CRLF); END;
01500
01510 FOR DX←0 STEP 1 UNTIL 512 DO D[DX]←0; DX←0;
01520 IF OPT1=1 THEN FOR QQ←1 STEP 1 UNTIL 4 DO BEGIN
01530 IF SEGC>JJ THEN DATAIN; IF SEGCT>JJT THEN DATTIN;
01540 FRIC;
01550 DATA; DAT[23]←M;
01560 OUTSTR(CVS(QQ)&" ");
01570 FOR K←0 STEP 1 UNTIL 23 DO OUTSTR(CVS(DAT[K])); OUTSTR(CRLF);
01580 END ELSE BEGIN
01590 FRIC;
01600 FOR K←0 STEP 1 UNTIL 23 DO AVDAT[K]←0;
01610 DATA; DAT[23]←M;
01620
01630 OUTSTR(" F ");
01640 FOR K←0 STEP 1 UNTIL 23 DO OUTSTR(CVS(DAT[K])); OUTSTR(CRLF);
01660 N←M;
01670
01680 FOR R←2 STEP 1 UNTIL KK DO BEGIN
01690 IF SEGC>JJ THEN DATAIN;
01700 IF SEGCT>JJT THEN DATTIN;
01710 FRIC; N←N+M; DATA; END;
01720 DAT[23]←M; AVDAT[23]←N;
01750 OUTSTR(" A ");
01760 FOR K←0 STEP 1 UNTIL 23 DO BEGIN
01770 AVDAT[K]←AVDAT[K]%KK; OUTSTR(CVS(AVDAT[K])); END; OUTSTR(CRLF);
01780 OUTSTR(" L ");
01790 FOR K←0 STEP 1 UNTIL 23 DO OUTSTR(CVS(DAT[K])); OUTSTR(CRLF);
01800 END;
01810
01840
01850 ⊂ Begin "SHOW";
01860
01870 WHILE TRUE DO BEGIN "SHOW"
01880 DPYOUT(0);PTOCHW(0,'10120); PTCNT←0;
01890 OUTSTR("space to cont., F for FFT, L for LPC, "&
01900 "# with CR to shift, S to start, E to exit."&crlf);
01910 READ1←INCHRW;
01920 SHUFCT←SHUFCT+1; IF SHUFCT<2 THEN RIVECT(40,0)
01930 ELSE BEGIN SHUFCT←0; SHUFFLE; END;
01940 K←CVASC(READ1); OPT1←0;
01950
01960 IF K≥CVASC("+") THEN IF K≤CVASC("9") THEN BEGIN
01970 JP←CVD(READ1&INCHWL); OPT1←1; KK←4; IF JP<(-J) THEN JP←(-J);
01980 JP↔J; J←J+JP; CONTINUE "GET"; END;
01990 OUTSTR(CR);
02000 IF READ1=" " THEN CONTINUE "SELECT";
02005 IF (READ1='15)∨(READ1='12) THEN BEGIN
02007 CLRBUF; CONTINUE "SELECT"; END;
02008 TOFORM:
02010 IF (READ1="F")∨(READ1="f") THEN BEGIN FORM(1); CLRBUF; END;
02020 IF (READ1="L")∨(READ1="l") THEN BEGIN FORM(0); CLRBUF; END;
02030 IF (READ1="S")∨(READ1="s") THEN BEGIN
02040 OUTSTR(LF&"You are starting over"&CRLF); CLRBUF;
02050 GOTO STARTP; END;
02060 IF (READ1="E")∨(READ1="e") THEN GOTO STOPP;
02080 END "SHOW";
02090 END "GET";
02100 END "FOUND";
02110 END "SELECT";
02120 END "FILEREAD";
02130
02140 OUTSTR("Data are exhausted"&CRLF&LF); GOTO STARTP;
02150 STOPP:
02160 END "PLOT";